home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / ada / gnat1792.zip / gnat179b / t-adainc / s-pthrea.adb < prev    next >
Text File  |  1994-05-19  |  25KB  |  807 lines
  1. ------------------------------------------------------------------------------
  2. --                                                                          --
  3. --                 GNU ADA RUNTIME LIBRARY (GNARL) COMPONENTS               --
  4. --                                                                          --
  5. --                        S Y S T E M . P T H R E A D S                     --
  6. --                                                                          --
  7. --                                  B o d y                                 --
  8. --                                                                          --
  9. --                             $Revision: 1.6 $                             --
  10. --                                                                          --
  11. --           Copyright (c) 1991,1992,1993, FSU, All Rights Reserved         --
  12. --                                                                          --
  13. --  GNARL is free software; you can redistribute it and/or modify it  under --
  14. --  terms  of  the  GNU  Library General Public License as published by the --
  15. --  Free Software Foundation; either version 2,  or (at  your  option)  any --
  16. --  later  version.   GNARL is distributed in the hope that it will be use- --
  17. --  ful, but but WITHOUT ANY WARRANTY; without even the implied warranty of --
  18. --  MERCHANTABILITY  or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Gen- --
  19. --  eral Library Public License for more details.  You should have received --
  20. --  a  copy of the GNU Library General Public License along with GNARL; see --
  21. --  file COPYING. If not, write to the Free Software Foundation,  675  Mass --
  22. --  Ave, Cambridge, MA 02139, USA.                                          --
  23. --                                                                          --
  24. ------------------------------------------------------------------------------
  25.  
  26. with Unchecked_Conversion;
  27.  
  28. package body System.Pthreads is
  29.  
  30.    -----------------------------------------------------------------------
  31.    --  These unchecked conversion functions are used to convert a variable
  32.    --  to an access value referencing that variable.  The expression
  33.    --  Address_to_Pointer(X'Address) evaluates to an access value referencing
  34.    --  X; if X is of type T, this expression returns a value of type
  35.    --  access T.  This is necessary to allow structures to be passed to
  36.    --  C functions, since some compiler interfaces to C only allows scalers,
  37.    --  access values, and values of type System.Address as actual parameters.
  38.    -----------------------------------------------------------------------
  39.  
  40.    --  ??? it would be better to use the routines in System.Storage_Elements
  41.    --  ??? for conversion between pointers and access values. In any case
  42.    --  ??? I don't see the point of these conversions at all, why not pass
  43.    --  ??? Address values directly to the C routines (I = RBKD)
  44.  
  45.    function Address_to_Pointer is new
  46.      Unchecked_Conversion (System.Address, POSIX_RTE.sigset_t_ptr);
  47.  
  48.    type pthread_t_ptr is access pthread_t;
  49.  
  50.    function Address_to_Pointer is new
  51.      Unchecked_Conversion (System.Address, pthread_t_ptr);
  52.  
  53.    type pthread_attr_t_ptr is access pthread_attr_t;
  54.  
  55.    function Address_to_Pointer is new
  56.      Unchecked_Conversion (System.Address, pthread_attr_t_ptr);
  57.  
  58.    type pthread_mutexattr_t_ptr is access pthread_mutexattr_t;
  59.  
  60.    function Address_to_Pointer is new
  61.      Unchecked_Conversion (System.Address, pthread_mutexattr_t_ptr);
  62.  
  63.    type pthread_mutex_t_ptr is access pthread_mutex_t;
  64.  
  65.    function Address_to_Pointer is new
  66.      Unchecked_Conversion (System.Address, pthread_mutex_t_ptr);
  67.  
  68.    type pthread_condattr_t_ptr is access pthread_condattr_t;
  69.  
  70.    function Address_to_Pointer is new
  71.      Unchecked_Conversion (System.Address, pthread_condattr_t_ptr);
  72.  
  73.    type pthread_cond_t_ptr is access pthread_cond_t;
  74.  
  75.    function Address_to_Pointer is new
  76.      Unchecked_Conversion (System.Address, pthread_cond_t_ptr);
  77.  
  78.    type pthread_key_t_ptr is access pthread_key_t;
  79.  
  80.    function Address_to_Pointer is new
  81.      Unchecked_Conversion (System.Address, pthread_key_t_ptr);
  82.  
  83.    type Address_Pointer is access System.Address;
  84.  
  85.    function Address_to_Pointer is new
  86.      Unchecked_Conversion (System.Address, Address_Pointer);
  87.  
  88.    type timespec_ptr is access POSIX_Timers.timespec;
  89.  
  90.    function Address_to_Pointer is new
  91.      Unchecked_Conversion (System.Address, timespec_ptr);
  92.  
  93.    type Integer_Ptr is access Integer;
  94.  
  95.    function Address_to_Pointer is new
  96.      Unchecked_Conversion (System.Address, Integer_Ptr);
  97.  
  98.    -----------------------
  99.    -- pthread_attr_init --
  100.    -----------------------
  101.  
  102.    procedure pthread_attr_init
  103.      (attributes : out pthread_attr_t;
  104.       result     : out Return_Code)
  105.    is
  106.       function pthread_attr_init_base
  107.         (attr : pthread_attr_t_ptr)
  108.          return Return_Code;
  109.       pragma Import (C, pthread_attr_init_base, "pthread_attr_init");
  110.  
  111.    begin
  112.       result :=
  113.         pthread_attr_init_base (Address_to_Pointer (attributes'Address));
  114.    end pthread_attr_init;
  115.  
  116.    -------------------------------
  117.    -- pthread_attr_setstacksize --
  118.    -------------------------------
  119.  
  120.    procedure pthread_attr_setstacksize
  121.      (attr      : in out pthread_attr_t;
  122.       stacksize : size_t;
  123.       result    : out Return_Code)
  124.    is
  125.       function pthread_attr_setstacksize_base
  126.         (attr      : pthread_attr_t_ptr;
  127.          stacksize : size_t)
  128.          return      Return_Code;
  129.       pragma Import
  130.         (C, pthread_attr_setstacksize_base, "pthread_attr_setstacksize");
  131.  
  132.    begin
  133.       result :=
  134.         pthread_attr_setstacksize_base
  135.           (Address_to_Pointer (attr'Address), stacksize);
  136.    end pthread_attr_setstacksize;
  137.  
  138.    ---------------------------------
  139.    -- pthread_attr_setdetachstate --
  140.    ---------------------------------
  141.  
  142.    procedure pthread_attr_setdetachstate
  143.      (attr        : in out pthread_attr_t;
  144.       detachstate : Integer;
  145.       result      : out Return_Code)
  146.    is
  147.       function pthread_attr_setdetachstate_base
  148.         (attr        : pthread_attr_t_ptr;
  149.          detachstate : Integer_Ptr)
  150.          return        Return_Code;
  151.       pragma Import
  152.         (C, pthread_attr_setdetachstate_base, "pthread_attr_setdetachstate");
  153.  
  154.    begin
  155.       Result :=
  156.         pthread_attr_setdetachstate_base (
  157.           Address_to_Pointer (attr'Address),
  158.           Address_to_Pointer (detachstate'Address));
  159.    end pthread_attr_setdetachstate;
  160.  
  161.    --------------------
  162.    -- pthread_create --
  163.    --------------------
  164.  
  165.    procedure pthread_create
  166.      (thread        : out pthread_t;
  167.       attributes    : pthread_attr_t;
  168.       start_routine : System.Address;
  169.       arg           : System.Address;
  170.       result        : out Return_Code)
  171.    is
  172.       function pthread_create_base
  173.         (thread        : pthread_t_ptr;
  174.          attr          : pthread_attr_t_ptr;
  175.          start_routine : System.Address; arg : System.Address)
  176.          return          Return_Code;
  177.       pragma Import (C, pthread_create_base, "pthread_create");
  178.  
  179.    begin
  180.       result :=
  181.         pthread_create_base (Address_to_Pointer (thread'Address),
  182.           Address_to_Pointer (attributes'Address), start_routine, arg);
  183.    end pthread_create;
  184.  
  185.    ------------------
  186.    -- pthread_init --
  187.    ------------------
  188.  
  189.    --  This procedure provides a hook into Pthreads initialization that allows
  190.    --  the addition of initializations specific to the Ada Pthreads interface
  191.  
  192.    procedure pthread_init is
  193.       procedure pthread_init_base;
  194.       pragma Import (C, pthread_init_base, "pthread_init");
  195.  
  196.    begin
  197.       pthread_init_base;
  198.    end pthread_init;
  199.  
  200.    --------------------
  201.    -- pthread_detach --
  202.    --------------------
  203.  
  204.    procedure pthread_detach
  205.      (thread : in out pthread_t;
  206.       result : out Return_Code)
  207.    is
  208.       function pthread_detach_base (thread : pthread_t_ptr) return Return_Code;
  209.       pragma Import (C, pthread_detach_base, "pthread_detach");
  210.  
  211.    begin
  212.       result := pthread_detach_base (Address_to_Pointer (thread'Address));
  213.    end pthread_detach;
  214.  
  215.    ----------------------------
  216.    -- pthread_mutexattr_init --
  217.    ----------------------------
  218.  
  219.    procedure pthread_mutexattr_init
  220.